ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Libraries/UMacApp.TEvtHandler.p

Text File | 1990-10-25 | 15.7 KB | 599 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UMacApp.TEvtHandler.p }
{ Copyright © 1984-1990 by Apple Computer Inc.    All rights reserved. }

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.IEvtHandler(itsNextHandler: TEvtHandler);

    BEGIN
    IObject;

    fNextHandler := itsNextHandler;
    fIdleFreq := kMaxIdleTime;                            { Assume it never wants idle time }
    fLastIdle := 0;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAClose}

PROCEDURE TEvtHandler.Free; OVERRIDE;

    BEGIN
    IF gTarget = SELF THEN
        IF fNextHandler = NIL THEN
            gApplication.SetTarget(gApplication)
        ELSE
            gApplication.SetTarget(fNextHandler);

    fNextHandler := NIL;
    INHERITED Free;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MANonRes}

FUNCTION TEvtHandler.AddHandler(headOfChain: TEvtHandler): TEvtHandler;

    BEGIN
    fNextHandler := headOfChain;
    AddHandler := SELF;                                 { new head of chain }
    END;

{--------------------------------------------------------------------------------------------------}
{$S MANonRes}

FUNCTION TEvtHandler.RemoveHandler(headOfChain: TEvtHandler): TEvtHandler;

    VAR
        prevCohandler:        TEvtHandler;
        currCohandler:        TEvtHandler;

    BEGIN
    prevCohandler := NIL;
    currCohandler := headOfChain;
    RemoveHandler := headOfChain;
    WHILE currCohandler <> NIL DO
        BEGIN
        IF currCohandler = SELF THEN                    { found it }
            BEGIN
            IF prevCohandler = NIL THEN                 { I was the head of the chain, so there will
                                                         be a new head of chain }
                RemoveHandler := fNextHandler
            ELSE
                prevCohandler.fNextHandler := fNextHandler; { take me out of the link }
            fNextHandler := NIL;                        { remember that i'm not in the chain anymore
                                                         }
            currCohandler := NIL;                        { So loop will end }
            END
        ELSE
            BEGIN
            prevCohandler := currCohandler;
            currCohandler := currCohandler.fNextHandler;
            END;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAFields}

PROCEDURE TEvtHandler.Fields(PROCEDURE DoToField(fieldName: Str255;
                                                 fieldAddr: Ptr;
                                                 fieldType: INTEGER));

    BEGIN
    DoToField('TEvtHandler', NIL, bClass);
    DoToField('fNextHandler', @fNextHandler, bObject);
    DoToField('fIdleFreq', @fIdleFreq, bLongInt);
    DoToField('fLastIdle', @fLastIdle, bLongInt);
    INHERITED Fields(DoToField);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAOpen}

FUNCTION TEvtHandler.CreateAView(itsDocument: TDocument;
                                 itsSuperView: TView;
                                 VAR itsParams: Ptr): TView;
{!!! Seems like there should be a class that is common to views, documents and application
like TEvtHandler, but without cluttering TEvtHandler with lots of detail crud like this }

    VAR
        aView:                TView;

    BEGIN
    IF fNextHandler <> NIL THEN
        aView := fNextHandler.CreateAView(itsDocument, itsSuperView, itsParams)
    ELSE
        BEGIN
        WITH ViewTemplatePtr(itsParams)^ DO
            IF itsType <> '' THEN
                BEGIN
                aView := TView(NewObjectByClassName(itsType));
                IF (aView = NIL) & (GetClassIDFromName(itsType) = kNilClass) THEN
                    BEGIN
                    {$IFC qDebug}
                    ProgramBreak(CONCAT('The application doesn’t contain the class ‘',
                                        ViewTemplatePtr(itsParams)^.itsType, '.’'));
                    {$ENDC}
                    gErrorParm3 := itsType;    { show name of class }
                    Failure(errMissingClass, 0);
                    END;
                END
            ELSE
                aView := TView(NewStdObject(itsSignature));

        IF aView <> NIL THEN
            aView.IRes(itsDocument, itsSuperView, itsParams);
        END;

    FailNIL(aView);
    CreateAView := aView;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.DoChoice(origView: TView;
                               itsChoice: INTEGER);

    BEGIN
    IF fNextHandler <> NIL THEN
        fNextHandler.DoChoice(origView, itsChoice)
    ELSE IF gIntenseDebugging THEN
        BEGIN
        Write('in TEvtHandler.DoChoice: no one handled the choice: ', itsChoice);
        WrLblHexLongint(' From view: ', ord(origView));
        WriteLn;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAOpen}

FUNCTION TEvtHandler.DoCreateViews(itsDocument: TDocument;
                                   parentView: TView;
                                   itsRsrcID: INTEGER;
                                   subviewOffset: VPoint): TView;

    VAR
        i:                    INTEGER;
        numViews:            INTEGER;
        aView:                TView;
        viewResource:        ViewRsrcHndl;
        theViewInfo:        ViewTemplatePtr;
        lastParentID:        IDType;
        lastParent:         TView;
        lastRoot:            TView;
        firstView:            TView;
        fi:                 FailInfo;

    PROCEDURE HdlDoCreateViews(error: OSErr;
                               message: LONGINT);

        BEGIN
        IF viewResource <> NIL THEN                     { Don't constipate the heap }
            HUnLock(Handle(viewResource));

        FreeIfObject(firstView);
        firstView := NIL;
        END;

    {$IFC qDebug}

    PROCEDURE ReportTemplate;

        BEGIN
        WITH theViewInfo^ DO
            BEGIN
            WrLblSig('signature', itsSignature);
            WriteLn;
            WrLblSig('itsParentID', itsParentID);
            WrLblSig(', thisViewID', thisViewID);
            WriteLn;
            WrLblVPt('itsLocation', itsLocation);
            WrLblVPt(', itsSize', itsSize);
            Write('itsHSizeDet = ', ord(itsHSizeDet): 3);
            WriteLn(', itsVSizeDet = ', ord(itsVSizeDet): 3);
            WrLblBoolean(', isEnabled ', isEnabled);
            WriteLn;
            WriteLn('----------  end of view  ----------');
            END;
        END;
    {$ENDC}

    BEGIN
    IF fNextHandler <> NIL THEN
        DoCreateViews := fNextHandler.DoCreateViews(itsDocument, parentView, itsRsrcID,
                                                    subviewOffset)
    ELSE
        BEGIN
        firstView := NIL;                                { Assume the worst. }

        viewResource := ViewRsrcHndl(GetResource('view', itsRsrcID));
        IF viewResource = NIL THEN
            BEGIN
            {$IFC qDebug}
            ProgramBreak(ConcatNumber('Unable to find ‘view’ resource #', itsRsrcID));
            {$ENDC}
            FailNilResource(viewResource);
            END;

        LockHandleHigh(Handle(viewResource));

        CatchFailures(fi, HdlDoCreateViews);

        numViews := viewResource^^.numViews;
        theViewInfo := @viewResource^^.theViews;
        lastParentID := kNoIdentifier;
        aView := parentView;
        lastRoot := parentView;

        FOR i := 1 TO numViews DO
            WITH theViewInfo^ DO
                BEGIN
                {$IFC qDebug}
                IF gIntenseDebugging THEN
                    ReportTemplate;
                {$ENDC}

                IF LONGINT(itsParentID) = LONGINT(kNoIdentifier) THEN
                    lastParent := parentView
                ELSE IF LONGINT(itsParentID) <> LONGINT(lastParentID) THEN
                    BEGIN
                    lastParent := aView;                { Begin with last view created or parentView
                                                         }
                    WHILE (lastParent <> NIL) & (lastParent.fIdentifier <> itsParentID) DO
                        lastParent := lastParent.fSuperView;

                    IF (lastParent = NIL) & (lastRoot <> NIL) THEN
                        IF aView <> NIL THEN
                            lastParent := aView.FindSubView(itsParentID)
                        ELSE
                            lastParent := lastRoot.FindSubView(itsParentID);

                    {$IFC qDebug}
                    IF lastParent = NIL THEN
                        ProgramBreak('Unable to find parent view for template');
                    {$ENDC}
                    END;
                lastParentID := itsParentID;

                IF LONGINT(itsSignature) = LONGINT('incl') THEN
                    BEGIN
                    aView := DoCreateViews(itsDocument, lastParent, includeRsrcID, gZeroVPt);
                    OffsetPtr(theViewInfo, SIZEOF(ViewTemplate) - SIZEOF(Str255) + SIZEOF(INTEGER));
                    END
                ELSE IF LONGINT(itsSignature) = LONGINT('inc@') THEN
                    BEGIN
                    aView := DoCreateViews(itsDocument, lastParent, includeRsrcID,
                             itsSubViewOffset);
                    OffsetPtr(theViewInfo, SIZEOF(ViewTemplate) - SIZEOF(Str255) +
                              SIZEOF(INTEGER) + SIZEOF(VPoint));
                    END
                ELSE
                    aView := CreateAView(itsDocument, lastParent, Ptr(theViewInfo));

                IF aView = NIL THEN
                    LEAVE;
                IF ((subviewOffset.h <> 0) | (subviewOffset.v <> 0)) & (aView.fSuperView =
                   parentView) & (parentView <> NIL) THEN
                    aView.Locate(aView.fLocation.h + subviewOffset.h, aView.fLocation.v +
                                 subviewOffset.v, kDontInvalidate);

                IF i = 1 THEN
                    BEGIN
                    firstView := aView;
                    IF Member(aView, TWindow) & (parentView = NIL) THEN
                        parentView := aView;
                    END;

                IF (lastRoot = NIL) & (aView <> NIL) & (aView.fSuperView = NIL) THEN
                    lastRoot := aView;
                END;

        HUnLock(Handle(viewResource));
        Success(fi);
        IF firstView <> NIL THEN
            firstView.AdjustSize;                        { Make sure size gets adjusted by the size
                                                         determiners }
        DoCreateViews := firstView;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.DoCommandKey(ch: Char;
                                  VAR info: EventInfo): TCommand;

    BEGIN
    IF fNextHandler <> NIL THEN
        DoCommandKey := fNextHandler.DoCommandKey(ch, info)
    ELSE
        DoCommandKey := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.DoHandleEvent(nextEvent: EventRecordPtr;
                                   VAR commandToPerform: TCommand): BOOLEAN;

    BEGIN
    DoHandleEvent := FALSE;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAHelp}

FUNCTION TEvtHandler.DoHelp(VAR info: EventInfo;
                            VAR message: UNIV LONGINT): TCommand;

    BEGIN
    IF fNextHandler <> NIL THEN
        DoHelp := fNextHandler.DoHelp(info, message)
    ELSE
        DoHelp := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.DoIdle(phase: IdlePhase): BOOLEAN;

    BEGIN
    DoIdle := FALSE;                                    { Did not free myself }
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.DoKeyCommand(ch: Char;
                                  aKeyCode: INTEGER;
                                  VAR info: EventInfo): TCommand;

    BEGIN
    IF fNextHandler <> NIL THEN
        DoKeyCommand := fNextHandler.DoKeyCommand(ch, aKeyCode, info)
    ELSE
        DoKeyCommand := NIL;                            {??? give an error ???}
    END;

{--------------------------------------------------------------------------------------------------}
{$S MASelCommand}

FUNCTION TEvtHandler.DoMenuCommand(aCmdNumber: CmdNumber): TCommand;

    BEGIN
    IF fNextHandler <> NIL THEN
        DoMenuCommand := fNextHandler.DoMenuCommand(aCmdNumber)
    ELSE
        BEGIN
        {$IFC qDebug}
        WriteLn('No one handled the command ', aCmdNumber: 1);
        {$ENDC}
        DoMenuCommand := NIL;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.DoMultiClick(lastDownPt, newDownPt: Point): BOOLEAN;

    BEGIN
    IF fNextHandler <> NIL THEN
        DoMultiClick := fNextHandler.DoMultiClick(lastDownPt, newDownPt)
    ELSE
        DoMultiClick := (ABS(lastDownPt.h - newDownPt.h) <= (gStdHysteresis.h)) &
                        (ABS(lastDownPt.v - newDownPt.v) <= (gStdHysteresis.v));
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.DoSetupMenus;

    BEGIN
    IF fNextHandler <> NIL THEN
        fNextHandler.DoSetupMenus;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.EachHandler(PROCEDURE DoToEvtHandler(anEvtHandler: TEvtHandler));

    VAR
        currHandler:        TEvtHandler;
        nextHandler:        TEvtHandler;

    BEGIN
    currHandler := SELF;
    WHILE currHandler <> NIL DO
        BEGIN
        { Get next handler now, in case DoToEvtHandler frees currHandler }
        nextHandler := currHandler.fNextHandler;
        DoToEvtHandler(currHandler);
        currHandler := nextHandler;
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.FirstHandlerThat(FUNCTION TestEvtHandler(anEvtHandler: TEvtHandler): BOOLEAN):
                                      TEvtHandler;

    VAR
        currHandler:        TEvtHandler;
        nextHandler:        TEvtHandler;

    BEGIN
    currHandler := SELF;
    WHILE currHandler <> NIL DO
        BEGIN
        { Get next handler now, in case DoToEvtHandler free currHandler }
        nextHandler := currHandler.fNextHandler;
        IF TestEvtHandler(currHandler) THEN
            BEGIN
            FirstHandlerThat := currHandler;
            EXIT(FirstHandlerThat);
            END;
        currHandler := nextHandler;
        END;
    FirstHandlerThat := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.HandlesPrintingCommands: BOOLEAN;

    BEGIN
    IF fNextHandler <> NIL THEN
        HandlesPrintingCommands := fNextHandler.HandlesPrintingCommands
    ELSE
        HandlesPrintingCommands := FALSE
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebug}

PROCEDURE TEvtHandler.IdentifySoftware;

    BEGIN
    IF fNextHandler <> NIL THEN
        fNextHandler.IdentifySoftware;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAActivate}

PROCEDURE TEvtHandler.InstallSelection(wasActive, beActive: BOOLEAN);

    BEGIN
    END;

{--------------------------------------------------------------------------------------------------}
{$S MADebug}

FUNCTION TEvtHandler.LookupSymbol(VAR sym: Str255): LONGINT;

    BEGIN
    IF fNextHandler <> NIL THEN
        LookupSymbol := fNextHandler.LookupSymbol(sym)
    ELSE
        LookupSymbol := - 1;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.CommitLastCommand;

    BEGIN
    IF fNextHandler <> NIL THEN
        fNextHandler.CommitLastCommand;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.GetNextCommand: TCommand;

    BEGIN
    IF fNextHandler <> NIL THEN
        GetNextCommand := fNextHandler.GetNextCommand
    ELSE
        GetNextCommand := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

FUNCTION TEvtHandler.GetLastCommand: TCommand;

    BEGIN
    IF fNextHandler <> NIL THEN
        GetLastCommand := fNextHandler.GetLastCommand
    ELSE
        GetLastCommand := NIL;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.PerformCommand(command: TCommand);

    BEGIN
    IF fNextHandler <> NIL THEN
        fNextHandler.PerformCommand(command)
    ELSE
        BEGIN
        {$IFC qDebug}
        WrLblHexLongint('No one performed the command ', ord(command));
        {$ENDC}
        IF command.fFreeOnCompletion THEN
            FreeIfObject(command);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.SetIdleFreq(newIdleFreq: LONGINT);

    BEGIN
    fIdleFreq := newIdleFreq;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.PostCommand(command: TCommand);

    BEGIN
    IF fNextHandler <> NIL THEN
        fNextHandler.PostCommand(command)
    ELSE
        BEGIN
        {$IFC qDebug}
        WrLblHexLongint('No one posted the command ', ord(command));
        {$ENDC}
        IF command.fFreeOnCompletion THEN
            FreeIfObject(command);
        END;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MATerminate}

PROCEDURE TEvtHandler.Terminate;

    BEGIN
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAEvtHandlerRes}

PROCEDURE TEvtHandler.KeyEventToComponents(VAR info: EventInfo);
    BEGIN
    IF fNextHandler <> NIL THEN
        fNextHandler.KeyEventToComponents(info)
    ELSE
        BEGIN
        WITH info, thePEvent^ DO
            IF (what = keyDown) | (what = autoKey) THEN
                BEGIN
                { Default extractions }
                theCharacter := chr(BAND(message, charCodeMask));
                theKeycode := BSR(BAND(message, keyCodeMask), 8);
                END;
        END;
    END;